home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / tex / wd2latex.zip / WD2LATEX.PAS < prev   
Pascal/Delphi Source File  |  1991-02-19  |  15KB  |  458 lines
  1. program translate_latex (input, output);
  2.  
  3. uses crt, dos, turbo3;
  4.  
  5. const
  6.      linefeed = ^J;
  7.      carriagereturn = ^M;
  8.      escape = ^[;
  9.      emptystring = ^@;
  10.      ctrl_A = ^A;
  11.      space = ' ';
  12.      si = ^O;              {Condensed print command}
  13.      so = ^N;              {Enlarged print command}
  14.      DC2 = ^R;             {Cancel condensed print}
  15.      DC4 = ^T;             {Cancel enlarged print}
  16.  
  17. type
  18.      textfil = text;
  19.      filespec = string[13];
  20.      string79 = string[79];
  21.      greek = set of 224..234;  {IBM PC Hi ASCII Characters}
  22.  
  23.  
  24. var
  25.      inputfile, outputfile : textfil;
  26.      filename : string79;
  27.      ch : char;
  28.      testio : integer;
  29.      success, needsource, flag_bold : boolean;
  30.  
  31. {---------------------------------------------------------------------------}
  32. procedure clean_window (x1, y1, x2, y2: integer);
  33.  
  34.   begin
  35.     window (x1, y1, x2, y2);
  36.     clrscr;
  37.     window (1, 1, 80, 25);
  38.   end;
  39.  
  40. {---------------------------------------------------------------------------}
  41. procedure Set_Video (attribute: integer);
  42.  
  43.   var
  44.      blinking,                {number to add for blinking}
  45.      bold : integer;          {number to add for bold}
  46.  
  47.   begin
  48.     blinking := (attribute and 4) * 4; { set blinking color based on MSB}
  49.     if (attribute and 1) = 1 then      {set reverse video}
  50.       begin
  51.         bold := (attribute and 2) * 7;
  52.         TextColor (1 + blinking + bold);
  53.         TextBackground (3);
  54.       end
  55.     else                               {set normal video colors}
  56.       begin
  57.         bold := (attribute and 2) * 5 div 2;
  58.         TextColor (7 + blinking + bold);
  59.         TextBackground (0);
  60.       end;
  61.   end;
  62.  
  63. {---------------------------------------------------------------------------}
  64. procedure put_string (out_string: string79;
  65.                line, col, attrib: integer);
  66.  
  67.   begin
  68.     set_video (attrib);
  69.     GotoXY (col, line);
  70.     write (out_string);
  71.     set_video (0);
  72.   end;
  73.  
  74.  
  75. {---------------------------------------------------------------------------}
  76. procedure put_centered_string (out_string: string79;
  77.                              line, attrib: integer);
  78.  
  79.   begin
  80.     put_string (out_string, line, 40 - length (out_string) div 2, attrib);
  81.   end;
  82.  
  83. {---------------------------------------------------------------------------}
  84. procedure put_prompt (out_string: string79;
  85.                        line, col: integer);
  86.  
  87.   begin
  88.     GotoXY (col, line);
  89.     Clreol;
  90.     put_string (out_string, line, col, 3);
  91.   end;
  92.  
  93. {---------------------------------------------------------------------------}
  94. procedure get_string (var in_string: string79;
  95.                   line, col, attrib,
  96.                          str_length: integer);
  97.  
  98.   const
  99.  
  100.     bell = 7;
  101.     back_space =8;
  102.     carriage_return = 13;
  103.     escape = 27;
  104.     right_arrow = 77;
  105.  
  106.   var
  107.     oldstr : string79;
  108.     in_char : char;
  109.     I : integer;
  110.  
  111.   begin
  112.     oldstr := in_string;
  113.     put_string (in_string, line, col, attrib);
  114.     for I := length (in_string) to str_length - 1 do
  115.       put_string (' ',     line, col + I, attrib);
  116.     GotoXY (col, line);
  117.     read (kbd, in_char);
  118.     if ord (in_char) <> carriage_return then
  119.       in_string := '';
  120.     while ord (in_char) <> carriage_return do
  121.       begin
  122.         if ord (in_char) = back_space then
  123.           begin
  124.             if length (in_string) > 0 then
  125.               begin
  126.                 in_string[0] := chr(length (in_string) - 1);
  127.                 write (chr(back_space));
  128.                 write (' ');
  129.                 write (chr(back_space));
  130.               end;
  131.           end
  132.         else if ord(in_char) = escape then
  133.           begin
  134.             read (kbd, in_char);
  135.             if ord (in_char) = right_arrow then
  136.               begin
  137.                 if length (oldstr) > length (in_string) then
  138.                   begin
  139.                     in_string[0] := chr(length (in_string) + 1);
  140.                     in_char := oldstr[ord(in_string[0])];
  141.                     in_string[ord(in_string[0])] := in_char;
  142.                     write (in_char);
  143.                   end
  144.               end
  145.             else
  146.               write (chr(bell));
  147.           end
  148.         else if length (in_string) < str_length then
  149.           begin
  150.             in_string[0] := chr(length (in_string) + 1);
  151.             in_string[ord(in_string[0])] := in_char;
  152.             write (in_char);
  153.           end
  154.         else
  155.           write (chr(bell));
  156.         read (kbd, in_char);
  157.      end;
  158.    put_string (in_string, line, col, attrib);
  159.    for I := length (in_string) to str_length - 1 do
  160.      put_string (' ', line, col + I, 0);
  161.   end;
  162.  
  163. {---------------------------------------------------------------------------}
  164. procedure get_prompted_string (var in_string: string79;
  165.                           inattr, str_length: integer;
  166.                                      strdesc: string79;
  167.                            descline, desccol: integer;
  168.                                       prompt: string79;
  169.                                prline, prcol: integer);
  170.  
  171. {sample call:
  172.      get_prompted_string (NAME, 1 ,30, 'Student Name: ', 10, 2,
  173.                           'Enter students'' full name.', 24, 2);
  174. }
  175.  
  176.   begin
  177.     put_string (strdesc, descline, desccol, 2);
  178.     put_prompt (prompt, prline, prcol);
  179.     get_string (In_string, descline, desccol + length (strdesc),
  180.                  inattr, str_length);
  181.     put_string (strdesc, descline, desccol, 0);
  182.   end;
  183.  
  184. {---------------------------------------------------------------------------}
  185. procedure read_char;
  186.    begin
  187.       read(inputfile,ch)
  188.    end;
  189.  
  190. {---------------------------------------------------------------------------}
  191. procedure ask_latex_command(ch: char);
  192.  
  193.    var
  194.       latex_command: string79;
  195.  
  196.    begin
  197.       latex_command := '';
  198.       clean_window (1, 13, 80, 25);
  199.       put_string ('Help! I don''t know LaTex for ', 15, 2, 2);
  200.       put_string (ch, 15, 31, 3);
  201.       get_prompted_string (latex_command, 1, 50, 'Enter LaTex equivalent: ',
  202.           17, 2, 'Enter Latex command as well as queried character', 24, 2);
  203.       write(outputfile, latex_command);
  204.       clean_window (1, 13, 80, 25);
  205.       put_centered_string ('Please wait: I''m still translating ', 18, 2);
  206.    end;
  207.  
  208. {---------------------------------------------------------------------------}
  209. procedure super_or_sub;  {Process Super- and Subscripts}
  210.    begin
  211.       read_char;
  212.       case ch of
  213.          '0', emptystring : write (outputfile, '$^{');
  214.          '1',      ctrl_A : write (outputfile, '$_{');
  215.       end; {* case *}
  216.    end;
  217.  
  218. {---------------------------------------------------------------------------}
  219. procedure h_tab;  {This filters out printer htab codes}
  220.    begin
  221.       read_char;
  222.       read_char;
  223.       write(outputfile, space);
  224.    end;
  225.  
  226.  
  227. {---------------------------------------------------------------------------}
  228. procedure ESC_rubbish;  {All printer codes not translated}
  229.    begin
  230.    if ch = 'K' then
  231.       begin
  232.         read_char; read_char
  233.       end
  234.    else
  235.       read_char
  236.    end;
  237.  
  238. {---------------------------------------------------------------------------}
  239. procedure escape_char;  {Escape precedes a lot of printer codes}
  240.    begin
  241.       read_char;
  242.       case ch of
  243.                    '4': write(outputfile,'{\it '); {request italics}
  244.                    '5': write(outputfile,'\/}');   {end italics}
  245.                    'E': write(outputfile,'{\bf '); {select bold face}
  246.                    'F': write(outputfile,'}');     {close braces}
  247.                    'g': write(outputfile,'{\sc '); {request small caps}
  248.     'p', 'C', 'J', 'K': ESC_rubbish;               {unwanted esc code}
  249.                    'T': write(outputfile,'}$');    {request math mode}
  250.                    'S': super_or_sub;              {request super/subscript}
  251.                    '$': h_tab;                     {remove horizontal tab}
  252.       end; (* case *)
  253.    end;
  254.  
  255. {---------------------------------------------------------------------------}
  256. procedure greek_char;
  257.           begin
  258.           case ord(ch) of
  259.